COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C***** MIXES AND LINKS FILES PUT OUT BY 'SCORE' *******
C00010 ENDMK
C⊗;
C***** MIXES AND LINKS FILES PUT OUT BY 'SCORE' *******
C***** ALL FILES MUST HAVE THE .SCR EXTENSION *****
C***** LOAD WITH RENAM.FAI 
C***** USE 'R LOADER'.  INCLUDE '/LLIB40.OLD[1,3]'.  OTHERWISE THERE
C	WILL BE READ ERRORS DUE TO BUGS IN CURRENT LIB40 3/77 *******

	COMMON /VV/KL,N1,N2,N3,J,K,L,M,P1,PX,A,B,C,D,IBL
	COMMON /LNK/ NK,NZ(20),IP /QQQ/QQQ(144) /RRR/RRR(144)
	DIMENSION Q(18)
	EQUIVALENCE (Q,QQQ)
	DATA IBL/'     '/
	TYPE 24
	NK=0
	LX=0
	ACCEPT 2,K,IP
	CALL LO2UP(K)
	CALL LO2UP(IP)
	IF(K.EQ.'L')LX=-1
200	TYPE 20
	ACCEPT 2,N1
	IF(N1.EQ.IBL)GO TO 200
	CALL LO2UP(N1)
	IF(FINDIT(N1))CALL NOTFND(N1)
C  DO A LOOKUP FIRST OF ALL
201	TYPE 22
	ACCEPT 2,N2
	CALL LO2UP(N2)
	IF(N2.EQ.IBL.OR.N2.EQ.N1)GO TO 201
	IF(FINDIT(N2))CALL NOTFND(N2)
	IF(LX.EQ.0)GO TO 202
1000	TYPE 41
	ACCEPT 2,K
	IF(K.EQ.IBL)GO TO 202
	CALL LO2UP(K)
C TAKES UP TO 2+10 FILES.
	NK=NK+1
	NZ(NK)=K
	IF(NK.LT.20)GO TO 1000
	
202	TYPE 23
	ACCEPT 2,N3
	IF(N3.EQ.IBL)GO TO 202
	CALL LO2UP(N3)
	CALL OFILE(1,N3)
	TYPE 300
300	FORMAT(' ****** CAUTION ******'/
	1' ****** NEVER STOP THIS PROGRAM WHILE IT IS WORKING ******'/)
	CALL RENAMX(N1,'SCR',N1,'DAT')
	CALL RENAMX(N2,'SCR',N2,'DAT')
	CALL IFILE(21,N1)
	CALL IFILE(22,N2)
	TYPE 25
	IF(LX.EQ.0)GO TO 25
	CALL LINK
	GO TO 204
25	FORMAT(/' WORKING'/)
	DO 1 K=1,3
	READ(21,2)Q
	WRITE(1,2)Q
1	READ(22,2)Q
C READS FIRST 3 LINES
	
	CALL CHECK(N,QQQ,P1,21)
	CALL CHECK(M,RRR,PX,22)
CATCHES INSERTED LINES.
6	IF(PX.LT.P1)GO TO 5
	CALL RDWRT(N,P1,QQQ,21)
	IF(KL)10,6,6

5	CALL RDWRT(M,PX,RRR,22)
	IF(KL.EQ.0)GO TO 6

11	PX=10000
	GO TO 13
10	P1=10000
13	IF(P1.NE.10000.OR.M.NE.N)GO TO 6
12	WRITE(1,7)
	REWIND 21
	REWIND 22
	CALL RENAMX(N1,'DAT',N1,'SCR')
	CALL RENAMX(N2,'DAT',N2,'SCR')
204	END FILE 1
	CALL RENAM(N3,'DAT',N3,'SCR')
	TYPE 203,N3
	CALL EXIT
203	FORMAT(/' ******  MIX FILE NAME = ',A5,'.SCR')
2	FORMAT(18A5)
7	FORMAT(' FINISH;')
24	FORMAT(' MIXES OR LINKS SCORE LISTS.'/
	1' USES ".SCR" EXTENSIONS ONLY!!! '/
	1' BE SURE ALL HIGHER PARAMS PRINT EACH TIME.'
	1//' L = LINK, <CR> = MIX  '$)
41	FORMAT(' TYPE NEXT FILE NAME OR <CR>  '$)
20	FORMAT(' TYPE FILE 1 (WITHOUT EXT.)   '$)
22	FORMAT(/' TYPE FILE 2  '$)
23	FORMAT(/' TYPE OUTPUT NAME  '$)
	END

	SUBROUTINE CHECK(N,Z,P1,J)
	COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P,PX,LL,K,IBL
	1 /QQQ/QQQ(144)
	DIMENSION AA(50),Z(144)
	DATA J1/7/,J2/12/,J3/21/
C  J1,J2,J3 ARE POINTERS TO POS. OF DOTS IN P1,P2
	KL=0
33	READ(J,30,END=100)Z         
	IF(Z(J1).NE.' ')GO TO 32
	IF(Z(J2).NE.'.')GO TO 32
	IF(Z(J3).EQ.'.')GO TO 31
CATCHES INSERTED LINES.
32	IF(Z(2).NE.'F')GO TO 300
	IF(Z(3).NE.'I')GO TO 300
	IF(Z(4).NE.'N')GO TO 300
	IF(Z(5).NE.'I')GO TO 300
	IF(Z(6).NE.'S')GO TO 300
	KL=-1
	N='FINIS'
300	CALL SHORT(Z)
	IF(KL)RETURN
	GO TO 33
100	PAUSE 'DIED IN SUBR CHECK'
31	REREAD 4,L,N,P1
30	FORMAT(144A1)
4	FORMAT(A1,A5,F)
44	FORMAT(A1,20A5)
	END

	SUBROUTINE SHORT(QQQ)
	COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P,PX,LL,K,A,B,IBL
	COMMON /LNK/ NK,NZ(20),IP
	DIMENSION QQQ(1)
	DO 1 K=144,1,-1
1	IF(QQQ(K).NE.' ')GO TO 2
2	IF(IP.NE.IBL)TYPE 44,(QQQ(LL),LL=1,K)
	IF(KL)RETURN
3	WRITE(1,44)(QQQ(LL),LL=1,K)
44	FORMAT(144A1)
	END

	SUBROUTINE RDWRT(I,P,Z,J)
	COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P1,PX,LL,K,IBL
	DIMENSION Z(144)
	KL=0
	DO 3 K=144,1,-1
3	IF(Z(K).NE.' ')GO TO 4
4	WRITE(1,44)(Z(N),N=1,K)
1	READ (J,44,END=100)Z
	DO 5 K=144,1,-1
5	IF(Z(K).NE.' ')GO TO 6
6 	WRITE(1,44)(Z(N),N=1,K)
 	IF(Z(1).NE.';')GO TO 1
	IF(Z(2).NE.'P')GO TO 1
	IF(Z(3).NE.'R')GO TO 1
	IF(Z(4).NE.'I')GO TO 1
	IF(Z(5).NE.'N')GO TO 1
	IF(Z(6).NE.'T')GO TO 1
2	CALL CHECK(I,Z,P,J)
	RETURN
44	FORMAT(144A1)
100	PAUSE 'DIED IN SUBR RDWRT'
	END

	SUBROUTINE LINK
	COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P1,PX,LL,K,IBL
	COMMON /LNK/ NK,NZ(20),IP /QQQ/QQQ(144)
44	FORMAT(144A1)
	KL=0
	JJ=0
	J=21
1	READ(J,44)QQQ
32	IF(QQQ(2).NE.'F')GO TO 4
	IF(QQQ(3).NE.'I')GO TO 4
	IF(QQQ(4).NE.'N')GO TO 4
	IF(QQQ(5).NE.'I')GO TO 4
	IF(QQQ(6).NE.'S')GO TO 4
	GO TO 2
4	CALL SHORT(QQQ)
	IF(JJ.GT.NK)RETURN
	GO TO 1
2	IF(J.NE.21)GO TO 3
	REWIND 21
	CALL RENAMX(N1,'DAT',N1,'SCR')
	J=J+1
	GO TO 1
3	REWIND 22
	IF(JJ.NE.0)GO TO 6
	CALL RENAMX(N2,'DAT',N2,'SCR')
	GO TO 5
6	CALL RENAMX(NZ(JJ),'DAT',NZ(JJ),'SCR')
5	JJ=JJ+1
	IF(JJ.GT.NK)GO TO 4
	CALL RENAMX(NZ(JJ),'SCR',NZ(JJ),'DAT')
	CALL IFILE(22,NZ(JJ))
	GO TO 1
	END

	SUBROUTINE RENAMX(J,K,L,M)
	CALL RENAM(J,K,L,M)
	TYPE 1,J,K,L,M
1	FORMAT(' (RENAME -- ',A5,'.',A3,' CHANGED TO -- ',A5,'.',A3,')')
	END
 
	SUBROUTINE NOTFND(NM)
	TYPE 1,NM
	CALL EXIT
1	FORMAT(' ******* FILE ',A5,'.SCR   NOT FOUND *****')
	END

	SUBROUTINE LO2UP(J)
C CONVERTS ALL LOWER CASE IN WORD J TO UPPER CASE.
	J=J.AND..NOT.((J/2).AND."201004020100)
	END